home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d19 / gw15pak.arc / GWTERM10.ARC / SOURCE.ARC / ASYNC.PAS < prev    next >
Pascal/Delphi Source File  |  1989-12-18  |  8KB  |  238 lines
  1. {$B-} { Short circuit boolean ON }
  2. {$I-} { I/O checking OFF }
  3. {$R-} { Range checking OFF }
  4. {$S-} { Stack checking OFF }
  5. {$V-} { Var-str checking OFF}
  6.  
  7. UNIT ASYNC;
  8.   {PD async unit debugged and modified for doorgame use by Joel Bergen}
  9.   {added com3 & com4 support and xon/xoff handshaking                 }
  10.  
  11. INTERFACE
  12.  
  13. USES Dos,CRT;
  14.  
  15. CONST
  16.   Async_Buffer_Max = 1024;          { size of input buffer }
  17. VAR
  18.   Async_OriginalVector : pointer;
  19.   Async_Buffer         : Array[0..Async_Buffer_Max] of char;
  20.  
  21.   Async_Open_Flag      : Boolean;   { true if Open but no Close }
  22.   Async_Pause          : Boolean;   { true if paused (Xoff received) }
  23.   Async_Port           : Integer;   { current Open port number (1..4) }
  24.   Async_Base           : Integer;   { base for current open port }
  25.   Async_Irq            : Integer;   { irq for current open port }
  26.  
  27.   Async_Buffer_Overflow: Boolean;   { True if buffer overflow has happened }
  28.   Async_Buffer_Used    : Word;      { number of characters in input buffer }
  29.  
  30.   { Async_Buffer is empty if Head = Tail }
  31.   Async_Buffer_Head    : Word;   { Locn in Async_Buffer to put next char }
  32.   Async_Buffer_Tail    : Word;   { Locn in Async_Buffer to get next char }
  33.  
  34. {----------------------------------------------------------------------------}
  35. {                          USER CALLABLE ROUTINES                            }
  36. {----------------------------------------------------------------------------}
  37.  
  38. PROCEDURE Async_Init;
  39.   { initialize variables, call first to initialize }
  40.  
  41. PROCEDURE Async_Close;
  42.   { reset the interrupt system when UART interrupts no longer needed }
  43.   { Turn off the COM port interrupts.                                }
  44.   { **MUST** BE CALLED BEFORE EXITING YOUR PROGRAM; otherwise you    }
  45.   { will see some really strange errors and have to re-boot.         }
  46.  
  47. FUNCTION Async_Open(ComPort,BaudRate : Word) : Boolean;
  48.   { open a communications port at 8/n/1 with supplied port & baud   }
  49.   { Sets up interrupt vector, initialies the COM port for           }
  50.   { processing, sets pointers to the buffer.  Returns FALSE if COM  }
  51.   { port not installed.                                             }
  52.  
  53. FUNCTION Async_Buffer_Check : Boolean;
  54.   { see if a character has been received        }
  55.   { If a character is available, returns TRUE   }
  56.   { Otherwise, returns FALSE                    }
  57.  
  58. FUNCTION Async_Read : Char;
  59.   { read a character, assuming it is ready}
  60.  
  61. PROCEDURE Async_Send(C : Char);
  62.   { transmit a character }
  63.  
  64. PROCEDURE Async_Hangup;
  65.   { drop carrier by dropping DTR}
  66.  
  67. FUNCTION Async_CarrierDetect : BOOLEAN;
  68.   { true if carrier detected }
  69. {----------------------------------------------------------------------------}
  70.  
  71. IMPLEMENTATION
  72.  
  73. CONST
  74.   I8088_IMR = $21;   { port address of the Interrupt Mask Register }
  75.   AsyncBasePort  : Array[1..4] OF WORD = ($03F8,$02F8,$03E8,$02E8);
  76.   AsyncIRQ       : Array[1..4] OF WORD = (4,3,4,3);
  77.  
  78. PROCEDURE DisableInterrupts; inline($FA {cli} );     {MACROS}
  79. PROCEDURE EnableInterrupts;  inline($FB {sti} );
  80.  
  81. PROCEDURE Async_Isr;  INTERRUPT;
  82. { Interrupt Service Routine
  83.   Invoked when the UART has received a byte of data from the
  84.   communication line }
  85. CONST
  86.   Xon  = #17;  {^q resume}
  87.   Xoff = #19;  {^s pause}
  88. VAR
  89.   c : Char;
  90. BEGIN
  91.   EnableInterrupts;
  92.   IF Async_Buffer_Used < Async_Buffer_Max THEN BEGIN
  93.     c := CHR(Port[Async_Base]);
  94.     CASE c OF
  95.       Xoff : Async_Pause:=TRUE;
  96.       Xon  : Async_Pause:=FALSE;
  97.       ELSE BEGIN
  98.         Async_Pause:=FALSE;
  99.         Async_Buffer[Async_Buffer_Head] := c;
  100.         IF Async_Buffer_Head < Async_Buffer_Max THEN
  101.           Inc(Async_Buffer_Head)
  102.         ELSE
  103.           Async_Buffer_Head := 0;
  104.         Inc(Async_Buffer_Used);
  105.       END;
  106.     END;
  107.   END ELSE Async_Buffer_Overflow := TRUE;
  108.   DisableInterrupts;
  109.   Port[$20] := $20;
  110. END; { Async_Isr }
  111.  
  112. PROCEDURE Async_Init;
  113. { initialize variables }
  114. BEGIN
  115.   Async_Open_Flag       := FALSE;
  116.   Async_Buffer_Head     := 0;
  117.   Async_Buffer_Tail     := 0;
  118.   Async_Buffer_Overflow := FALSE;
  119.   Async_Buffer_Used     := 0;
  120.   Async_Pause           := FALSE;
  121. END; { Async_Init }
  122.  
  123. PROCEDURE Async_Close;
  124. { reset the interrupt system when UART interrupts no longer needed }
  125. VAR
  126.   i, m : INTEGER;
  127. BEGIN
  128.   IF Async_Open_Flag THEN BEGIN
  129.     DisableInterrupts;           { disable IRQ on 8259 }
  130.     i := Port[I8088_IMR];        { get the interrupt mask register }
  131.     m := 1 shl Async_Irq;        { set mask to turn off interrupt }
  132.     Port[I8088_IMR] := i or m;
  133.     Port[Async_Base + 1] := 0;   { disable 8250 data ready interrupt}
  134.     EnableInterrupts;
  135.     SetIntVec(Async_Irq + 8,Async_OriginalVector);
  136.     Async_Open_Flag := FALSE     { flag port as closed }
  137.   END
  138. END; { Async_Close }
  139.  
  140. FUNCTION Async_Open(ComPort,BaudRate : WORD) : Boolean;
  141. { open a communications port. This unit will only open 1 port at a time }
  142. VAR
  143.   i, m : INTEGER;
  144.   b : Byte;
  145. BEGIN
  146.   IF Async_Open_Flag THEN Async_Close;
  147.   Async_Port := ComPort;
  148.   Async_Base := AsyncBasePort[Async_Port];
  149.   Async_Irq  := AsyncIRQ[Async_Port];
  150.   IF (Port[Async_Base + 2] AND $00F8) <> 0 THEN
  151.     Async_Open := FALSE
  152.   ELSE BEGIN
  153.       { set comm parameters }
  154.     Port[Async_Base + 3] := $03;  {set 8/n/1. Yes, this shouldn't be hardcoded}
  155.       { set ISR vector }
  156.     GetIntVec(Async_Irq + 8, Async_OriginalVector);
  157.     SetIntVec(Async_Irq + 8, @Async_Isr);
  158.       { read the RBR and reset any possible pending error conditions }
  159.       { first turn off the Divisor Access Latch Bit to allow access to RBR, etc. }
  160.     DisableInterrupts;
  161.     Port[Async_Base + 3] := Port[Async_Base + 3] AND $7F;
  162.       { read the Line Status Register to reset any errors it indicates }
  163.     i := Port[Async_Base + 5];
  164.       { read the Receiver Buffer Register in case it contains a character }
  165.     i := Port[Async_Base];
  166.       { enable the irq on the 8259 controller }
  167.     i := Port[I8088_IMR];  { get the interrupt mask register }
  168.     m := (1 shl Async_Irq) XOR $00FF;
  169.     Port[I8088_IMR] := i AND m;
  170.       { enable the data ready interrupt on the 8250 }
  171.     Port[Async_Base + 1] := $01; { enable data ready interrupt }
  172.       { enable OUT2 on 8250 }
  173.     i := Port[Async_Base + 4];
  174.     Port[Async_Base + 4] := i OR $08;
  175.     EnableInterrupts;
  176.       { Set baudrate}
  177.     b := Port[3+Async_Base] OR 128;
  178.     Port[3+Async_Base]:= b;
  179.     Port[Async_Base]  := lo(trunc(115200.0/BaudRate));
  180.     Port[1+Async_Base]:= hi(trunc(115200.0/BaudRate));
  181.     Port[3+Async_Base]:= b AND 127;
  182.       { set flags }
  183.     Async_Open_Flag := TRUE;
  184.     Async_Open := TRUE
  185.   END
  186. END; { Async_Open }
  187.  
  188. FUNCTION Async_Buffer_Check : Boolean;
  189. { return true if character ready to receive }
  190. BEGIN
  191.   Async_Buffer_Check := (Async_Buffer_Used <> 0);
  192. END; { Async_Buffer_Check }
  193.  
  194. FUNCTION Async_Read : Char;
  195. { return char, use Async_Buffer_Check first! }
  196. BEGIN
  197.   Async_Read := Async_Buffer[Async_Buffer_Tail];
  198.   Inc(Async_Buffer_Tail);
  199.   IF Async_Buffer_Tail > Async_Buffer_Max THEN
  200.     Async_Buffer_Tail := 0;
  201.   Dec(Async_Buffer_Used);
  202. END; { Async_Buffer_Check }
  203.  
  204. PROCEDURE Async_Send(c : CHAR);
  205. { transmit a character }
  206. BEGIN
  207.   Port[Async_Base + 4] := $0B;                   {turn on OUT2, DTR, and RTS}
  208.   WHILE (Port[Async_Base + 6] AND $10) = 0 DO;   {wait for CTS}
  209.   WHILE (Port[Async_Base + 5] AND $20) = 0 DO;   {wait for Tx Holding Reg Empty}
  210.   WHILE Async_Pause AND Async_CarrierDetect DO;  {wait for Xon}
  211.   DisableInterrupts;
  212.   Port[Async_Base] := Ord(c);                    {send the character}
  213.   EnableInterrupts;
  214. END; { Async_Send }
  215.  
  216. PROCEDURE Async_Hangup;
  217. BEGIN
  218.   Port[Async_Base+4] := $00;    {dtr off}
  219.   Delay(1000);                  {wait 1 second}
  220.   Port[Async_Base+4] := $03;    {dtr on}
  221. END;
  222.  
  223. FUNCTION Async_CarrierDetect : BOOLEAN;
  224. {true if carrier}
  225. VAR
  226.   b : BOOLEAN;
  227.   w : WORD;
  228. BEGIN
  229.   w:=0; b:=TRUE;
  230.   WHILE (w<500) AND b DO BEGIN              {make sure carrier stays down}
  231.     Inc(w);                                 {and is not just a fluke     }
  232.     b:=(PORT[Async_Base+6] AND 128) <> 128; {true = no carrier};
  233.   END;
  234.   Async_CarrierDetect := NOT b;
  235. END;
  236.  
  237. END. { ASYNC UNIT }
  238.